home *** CD-ROM | disk | FTP | other *** search
/ SunSoft Catalyst CDWARE 1996 May to August / Catalyst CDWARE 1996 May to August.iso / .products / .bin / httpd / Solaris_1 / brandnewwais.pl < prev    next >
Perl Script  |  1996-03-21  |  7KB  |  269 lines
  1. #!./perl
  2. #
  3. # newwais.pl -- WAIS search interface
  4. #
  5. # from wais.pl
  6. #
  7. # Tony Sanders <sanders@bsdi.com>, Nov 1993
  8. #
  9. # Example configuration (in local.conf):
  10. #     map topdir wais.pl &do_wais($top, $path, $query, "database", "title")
  11. #
  12. # this script uses a sneaky feature of Mosaic that interpretes a 
  13. # single text input form with the name 'isindex' (case sensitive) to
  14. # the same as a <ISINDEX>.  On non-mosaic clients, you wind up with an
  15. # additional query
  16. #
  17. # Note that I know even less about perl than the other two people
  18. # who hacked this, so feel free to send hate mail to pjh@netcom.com
  19. # if I did something really bad (or if there is a better way of
  20. # grabbing the filename off the end of a path.
  21. #
  22. #
  23.  
  24. # parse disc name from ServerName Environt Variable with this script
  25.  
  26. do './variables.pl';
  27.  
  28. &get_request;
  29.  
  30. $oldLIB = $ENV{"LD_LIBRARY_PATH"}; 
  31. $ENV{"LD_LIBRARY_PATH"} = "$oldLIB:/usr/ucblib"; 
  32.  
  33.  
  34. #require 'ctime.pl';
  35.  
  36. $waisq = "./waisq";
  37. $waisd = "/tmp/.wais/wais_$disc_name";
  38.  
  39.  
  40. $src = "wais_$disc_name";
  41. $title = "Example Data";
  42. #
  43. # file type map based on file extension, since all file types
  44. # come back type URL
  45. #
  46.  
  47. %filetype = (
  48. 'html', 'HTML File', 'ps', 'PostScript  Document',
  49. 'htm', 'HTML File', 'eps', 'PostScript  Document',
  50. 'txt','Text File', 'home', ''
  51. );
  52. $filetype{home}="Home page on $disc_name";
  53.  
  54. open(IN,"/tmp/httpd/.products/.bin/real_names.txt") || die "howdy";
  55.      while (<IN>) {
  56.         @tmp = split(/    /,$_);
  57.         $dir = @tmp[0];
  58.         $realname = @tmp[1];
  59.     #print "test $dir   $realname\n";
  60.     $real_name{$dir} = $realname;
  61.      }
  62. close(IN);
  63.  
  64. #
  65. # code
  66. # 
  67. sub get_request {
  68.  
  69.     if ($ENV{'REQUEST_METHOD'} eq "POST") {
  70.         read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
  71.     } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
  72.         $request = $ENV{'QUERY_STRING'};
  73.     }
  74.  
  75.  
  76.     @names = &url_decode(split(/[&=]/, $request));
  77.     %rqpairs = @names;
  78.  
  79. }
  80.  
  81. sub url_decode {
  82.  
  83. #       Decode a URL encoded string or array of strings
  84. #               + -> space
  85. #               %xx -> character xx
  86.  
  87.  
  88.     foreach (@_) {
  89.         tr/+/ /;
  90.         s/%(..)/pack("c",hex($1))/ge;
  91.     }
  92.     @_;
  93. }
  94.  
  95. sub send_index {
  96.     print "Content-type: text/html\n\n";
  97.     
  98.     print "<HEAD>\n<TITLE>Index of ", $title, "</TITLE>\n</HEAD>\n";
  99.     print "<BODY  bgcolor=\"#DDDDDD\">\n<H1>", $title, "</H1>\n";
  100.  
  101.     print "This is an index of the information on this server. Please\n";
  102.     print "type a query in the search dialog.\n<P>";
  103.     print "You may use compound searches, such as: <CODE>environment AND cgi</CODE>\n";
  104.     print "<ISINDEX>";
  105. }
  106.  
  107.  
  108. sub do_wais {
  109. #    local($top, $path, $query, $src, $title) = @_;
  110.  
  111.  
  112.  
  113. #    for (@_){s/\\//g};
  114.  
  115.     local(@query) = $rqpairs{"isindex"};
  116.     
  117.     local($pquery) = join(" ", @query);
  118.     local($nquery) = $pquery;
  119.     $nquery =~ tr/[A-Z]/[a-z]/;
  120.     if (!(($nquery =~ / and /) || ($nquery =~ / or /)))
  121.     {
  122.        $nquery =~ s/ //g;
  123.     }
  124.     $nquery = $request;
  125. #
  126. # grab a wais source if there is one
  127. #
  128.  
  129.     local($test) = $ENV{'PATH_INFO'};
  130.     if ($test)
  131.     {
  132.     $test =~ s/\///;
  133.         $src = "wais_$disc_name";
  134.         $title = $test;
  135.     }
  136.  
  137.     close STDERR;
  138.     open(STDERR, ">/dev/null");
  139.  
  140.     print "Content-type: text/html\n\n";
  141.  
  142.     $ENV{'HOME'} = "/";
  143.     
  144.     open(WAISQ, "-|") || exec ($waisq, "-c", $waisd, "-m", 100,
  145.                                 "-f", "-", "-S", "$src.src", "-g", $nquery);
  146.  
  147.     print "<HEAD>\n<TITLE>Search of ", "$disc_name $disc_rest", "</TITLE>\n</HEAD>\n";
  148.     print "<img src=\"/.wais/images/goto_home.gif\">\n";
  149.     print "<BODY bgcolor=\"#DDDDDD\">\n<H1> $disc_name $disc_rest Search Results</H1>\n";
  150.  
  151.     print "<HR><FORM method=\"GET\" action=\"/cgi-bin/brandnewwais.pl/$src\">\n";
  152.     print "<h2>Enter keyword(s):\n";
  153. #    print "<input name=\"isindex\" value=\"@query\" size=30></FORM><HR>\n";
  154.     print "<input name=\"isindex\" value=\"$nquery\" size=30></FORM><HR></h2>\n";
  155.     
  156.     print "Your search found the following documents\n";
  157.     print "items relevant to <B>\`$nquery\':</B><P>\n";
  158.         print "<center>";
  159.         print "<table border=5>";
  160.     print "<DL>\n";
  161.         print "<th> Company Name</th>";
  162.         print "<th> Document Matched</th>";
  163.         print "<th> Document Type</th>";
  164.         print "<tr>\n";
  165.  
  166.  
  167.     #local($hits, $score, $headline, $lines, $bytes, $type, $date);
  168.     local($hits, $score, $lines, $bytes, $type, $date);
  169.  
  170. $hits = -1;
  171.     print "<OL>";
  172.     while (<WAISQ>) {
  173.         /:score\s+(\d+)/ && ($score = $1);
  174.         /:number-of-lines\s+(\d+)/ && ($lines = $1);
  175.         /:number-of-bytes\s+(\d+)/ && ($bytes = $1);
  176.         /:type "(.*)"/ && ($type = $1);
  177.         /:headline "(.*)"/ && ($headline = $1);         # XXX
  178.         /:date "(\d+)"/ && ($date = $1, $hits++, &docdone);
  179.     }
  180.     &display;
  181.     print "</OL>";
  182.     close(WAISQ);
  183.     print "</DL>\n";
  184.  
  185.     print "</BODY>\n";
  186. }
  187.  
  188.  
  189.  
  190.  
  191.  
  192. #
  193. # THis sub was set up to grab the context of the string.
  194. # It needs to be emplemented
  195. #
  196. sub display {
  197.     for ($i = 0; $i <= $length_context - 1; $i++ ) {
  198.     @tmp = split(/,/,@pcontext[$i]);
  199.     $href = @tmp[1];
  200.     $name = @tmp[0];
  201.     $filename = @tmp[4];
  202.     $test = @tmp[5];
  203.     $ext = @tmp[3];
  204.     $ii = $i+1;
  205.  
  206.         print "<td><A HREF=\"file:///tmp/httpd/.products/$name/$disc_name.frame.html\">";
  207.  
  208.         #$name =~ s/_/ /g; 
  209.  
  210.     print "<B><b>$ii. $real_name{$name} </b></a></td>";
  211.     print "<td><A HREF=\"$href\"><B><b>$filename</B></b></A></td>";
  212.         print "<td> $filetype{$ext} \n</td>";
  213.     print "<tr>";
  214.  
  215.     }
  216.     print "</table>";
  217.     print "</center>";
  218. }
  219.  
  220.  
  221. sub docdone {
  222.  
  223.     if ($headline =~ /Search produced no result/) {
  224.         print "<HR>";
  225.         print "<h2>Search produced no result.</h2>";
  226. #        print $headline, "<P>\n<PRE>";
  227. # the following was &'safeopen
  228. #        open(WAISCAT, "$waisd/$src.cat") || die "$src.cat: $!";
  229. #        while (<WAISCAT>) {
  230. #            s#(Catalog for database:)\s+.*#$1 <STRONG>Catalyst Catalog on $disc_name</STRONG>#;
  231. #            s#Headline:\s+(.*)#Headline: <A HREF="$1">$1</A>#;
  232. #            print;
  233. #        }
  234. #        close(WAISCAT);
  235. #        print "\n</PRE>\n";
  236.     } else {
  237.         $docname = $headline;
  238.     $docname =~ s/\.([^.]*)$//;
  239.     $extension= $1;
  240.     $docname =~ s/\/([^\/]*)$//;
  241.     $docname = $1;
  242.     $filename = $docname;
  243.     $docname = $1;
  244.     #$docname = $headline;
  245.            #$docname =~ s/\/([^\/]*)$//;
  246.  
  247.         $test = $headline;
  248.         $test =~ s/file:\/\///;
  249.            $test =~ s/\/([^\/]*)$//;
  250.  
  251.         if ($headline =~ /products\/.([^\/]*)\/index/) { $extension = "home"; }
  252.  
  253.     while ($test =~ /.products/) {
  254.     $filler = $docname;
  255.            $test =~ s/\/([^\/]*)$//;
  256.     $docname = $1;
  257.     }
  258.     $docname = $filler;
  259.     @context = ($docname,$headline,$filetype,$extension,$filename);
  260.     @pcontext[$hits] = join (",", @context); 
  261.     
  262.     }
  263.     $length_context = @pcontext;
  264.     
  265.     $score = $headline = $lines = $bytes = $type = $date = '';
  266. }
  267.  
  268. eval '&do_wais';
  269.